home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue29 / construc / SCANNER.DPR < prev   
Encoding:
Text File  |  1997-11-27  |  3.1 KB  |  116 lines
  1. {$APPTYPE CONSOLE}
  2. {$I-}
  3. uses
  4.   SysUtils;
  5.  
  6. const
  7.   website = 'http://www.drbob42.com';
  8.  
  9. const
  10.   IdentSet = ['A'..'Z','a'..'z','0'..'9','-','+'];
  11.   StartSet = ['A'..'Z','a'..'z'];
  12.  
  13. var
  14.   f: Text;
  15.   MaxFileName, MaxKeyword, Str: ShortString;
  16.   MaxLen: Byte absolute MaxKeyword;
  17.   Len: Byte absolute Str;
  18.   WebPages: Word = 0;
  19.   Size: LongInt = 0;
  20.  
  21.   procedure ScanFiles;
  22.   var
  23.     SRec: TSearchRec;
  24.     NotInTag: Boolean;
  25.   begin
  26.     if FindFirst('*.*', faDirectory, SRec) = 0 then
  27.     repeat
  28.       if (SRec.Attr AND faDirectory) = faDirectory then
  29.       begin
  30.         if (SRec.Name[1] <> '.') then { skip '.' and '..' }
  31.         if Pos('_vti',SRec.Name) = 0 then { _vti_cnf etc. }
  32.         begin
  33.           ChDir(SRec.Name);
  34.           if IOResult = 0 then
  35.           begin
  36.             writeln('<LI><I>',SRec.Name,'</I>');
  37.             writeln('<UL>');
  38.             ScanFiles; { recursive!! }
  39.             writeln('</UL>');
  40.             ChDir('..')
  41.           end
  42.           else
  43.             writeln('<LI><I>',SRec.Name,'</I> - locked')
  44.         end
  45.       end
  46.       else { file }
  47.       if (Pos('.HTM',UpperCase(SRec.Name)) > 0) or
  48.          (Pos('.ASP',UpperCase(SRec.Name)) > 0) then
  49.       begin
  50.         writeln('<LI><B>',SRec.Name, '</B> (',SRec.Size,' bytes)');
  51.         Size := Size + SRec.Size;
  52.         assign(f,SRec.Name);
  53.         reset(f);
  54.         if IOResult = 0 then
  55.         begin
  56.           Inc(WebPages);
  57.           NotInTag := True;
  58.           while not eof(f) do
  59.           begin
  60.             Len := 0;
  61.             while not eoln(f) do
  62.             begin
  63.               Inc(Len);
  64.               read(f,Str[Len]);
  65.               if not (Str[Len] in IdentSet) then
  66.               begin
  67.                 Dec(Len);
  68.                 if (Len > MaxLen) and NotInTag then
  69.                 begin
  70.                   MaxKeyword := Str;
  71.                   MaxFileName := SRec.Name
  72.                 end;
  73.                 if Str[Len+1] = '>' then NotInTag := True
  74.                 else
  75.                   if Str[Len+1] = '<' then NotInTag := False;
  76.                 Len := 0
  77.               end
  78.               else
  79.                 if (Len = 1) then { start with letter ?? }
  80.                   if not (Str[1] in StartSet) then Len := 0
  81.             end;
  82.             if (Len > MaxLen) and NotInTag then
  83.             begin
  84.               MaxKeyword := Str;
  85.               MaxFileName := SRec.Name
  86.             end;
  87.             readln(f)
  88.           end;
  89.           close(f)
  90.         end
  91.       end
  92.     until FindNext(SRec) <> 0;
  93.     FindClose(SRec)
  94.   end {ScanFiles};
  95.  
  96. begin
  97.   ChDir('..'); { get out of cgi-bin }
  98.   if IOResult <> 0 then { skip };
  99.   writeln('content-type: text/html');
  100.   writeln;
  101.   writeln('<HTML>');
  102.   writeln('<BODY BACKGROUND="/gif/back.gif">');
  103.   writeln('<H2>IndexBob</H2>');
  104.   writeln('Scanning website ',website);
  105.   writeln('<P>');
  106.   writeln('<UL>');
  107.   ScanFiles;
  108.   writeln('</UL>');
  109.   writeln('<HR>');
  110.   writeln('Longest Keyword: ',MaxLen,' =[',MaxKeyword,'] in ',MaxFileName);
  111.   writeln('<BR>Number of Webpages: ',WebPages,' (',Size div 1024,' Kbytes)');
  112.   writeln('<HR>');
  113.   writeln('</BODY>');
  114.   writeln('</HTML>')
  115. end.
  116.